home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.03 Mar 89 / MPWSource Code / ChangeTextRes.p < prev    next >
Encoding:
Text File  |  1988-11-08  |  7.6 KB  |  262 lines  |  [TEXT/MPS ]
  1. program ChangeTextRes;
  2. {
  3.     ChangeTextRes.p
  4.     ---------------
  5.     An MPW Tool to delete resource fork of MPW text
  6.     files and rewrite the resource fork to specify
  7.     a desired tab setting, font, and font size.
  8.     
  9.     (c) TML Systems, Inc., 1988
  10.     All rights reserved.
  11. }
  12.  
  13. uses    MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, PasLibIntf,
  14.  
  15.         CursorCtl, IntEnv;        { required for MPW Tools }
  16.  
  17.  
  18. var    ResRefNum:    integer;        { reference number for resource fork of a given file }
  19.         filename:    Str255;
  20.         aStringPtr:    StringPtr;
  21.         vRefNum:        integer;        { reference number for default drive }
  22.         fnderInfo:    FInfo;        { Finder information for a given file }
  23.         anOSError:    OSErr;        { result from Mac ROM file I/O calls }
  24.         arg:            LongInt;        { passed to IEFAccess specifies font and font size }
  25.         result:        LongInt;        { result from IEFAccess calls }
  26.         i:                integer;
  27.         
  28.         gFont:        integer;        { Font number of specified font as returned by GetFNum }
  29.         gFontSize:    longint;
  30.         gTabSize:    longint;        { tab setting }
  31.         gResDelete:    boolean;        { delete all of file's resources? }
  32.  
  33.  
  34.     function UpperCase(str: Str255): Str255;
  35.     {
  36.         Convert an alpanumeric string to all uppercase characters.
  37.     }
  38.     var i: integer;
  39.     begin
  40.         for i := 1 to length(str) do
  41.             if (str[i] >= 'a') and (str[i] <= 'z') then
  42.                 str[i] := chr(ord(str[i]) - 32);
  43.         UpperCase := str;
  44.     end;
  45.     
  46.     
  47.     procedure SyntaxError(err: integer; msg: Str255);
  48.     {
  49.         Display the appropriate syntax error and then
  50.         exit from the program.  Return a status value
  51.         of 1 indicating an early termination of program.
  52.     }
  53.     begin
  54.         case err of
  55.             1:    writeln('# ',msg,' is an invalid option');
  56.             2:    writeln('# missing font');
  57.             3:    writeln('# missing font size');
  58.             4:    writeln('# missing tab setting');
  59.             5:    writeln('# ',msg,' is an invalid font');
  60.             6:    writeln('# ',msg,' is an invalid font size');
  61.             7:    writeln('# ',msg,' is an invalid tab size');
  62.             8:    writeln('# the - character must be accompanied by an option');
  63.             9:    begin
  64.                     writeln('# Usage - ChangeTextRes [name…]  ');
  65.                     writeln('     -f fontname    # set font of files to fontname');
  66.                     writeln('     -s fontsize    # set font size of files to fontsize');
  67.                     writeln('     -t tabs        # set tab setting to tabs');
  68.                 end;
  69.             otherwise    writeln('fatal error #',err);
  70.         end;
  71.         IEExit(1);        { return error status, 1 = syntax error }
  72.     end;
  73.     
  74.     
  75.     procedure HandleOption(opt: Str255; var argIndex: integer);
  76.     {
  77.         Set the appropriate global flag for each command line
  78.         option encountered on the command line.  If an invalid
  79.         option is found, give an error message and exit from the
  80.         program.  If the option requires an additional command
  81.         line parameter (e.g. -f Monaco), then retrieve the option(s)
  82.         needed and increment the argIndex counter appropriately.
  83.     }
  84.     var    NumString,
  85.             str:            Str255;
  86.     begin
  87.         str := UpperCase(opt);
  88.         Delete(str, 1,1);                {delete the '-' character}
  89.         if str = 'F' then begin                { set font }
  90.             argIndex := argIndex + 1;
  91.             if argIndex < argc then begin
  92.                 GetFNum(argv^[argIndex]^, gFont);
  93.                 if gFont < 0 then
  94.                     SyntaxError(5,argv^[argIndex]^);
  95.             end
  96.             else
  97.                 SyntaxError(2,'');
  98.         end
  99.         else if str = 'S' then begin        { set font size }
  100.             argIndex := argIndex + 1;
  101.             if argIndex < argc then begin
  102.                 StringToNum(argv^[argIndex]^,gFontSize);
  103.                 if (gFontSize <= 0) or (gFontSize >= 128) then begin
  104.                     NumToString(gFontSize,NumString);
  105.                     SyntaxError(6,NumString);
  106.                 end;
  107.             end
  108.             else
  109.                 SyntaxError(3,'');
  110.         end
  111.         else if str = 'T' then begin        { set tab }
  112.             argIndex := argIndex + 1;
  113.             if argIndex < argc then begin
  114.                 StringToNum(argv^[argIndex]^,gTabSize);
  115.                 if (gTabSize <= 0) or (gTabSize >= 25) then begin
  116.                     NumToString(gFontSize,NumString);
  117.                     SyntaxError(7,NumString);
  118.                 end;
  119.             end
  120.             else
  121.                 SyntaxError(4,'');
  122.         end
  123.         else if str = 'D' then                { delete file's resources }
  124.             gResDelete := true
  125.         else SyntaxError(1,str);
  126.     end;
  127.     
  128.     
  129.     procedure SkipOption(opt: Str255; var argIndex: integer);
  130.     {
  131.         This routine is called only after the command line parameters
  132.         have already been scanned once using HandleOption.  The
  133.         purpose of this routine is to properly increment argIndex
  134.         according to the appropriate command line options.
  135.     }
  136.     var    str: Str255;
  137.     begin
  138.         str := UpperCase(opt);
  139.         Delete(str, 1,1);                    {delete the '-' character}
  140.         
  141.         if str = 'F' then                { set font }
  142.             argIndex := argIndex + 1
  143.         else if str = 'S' then            { set font size }
  144.             argIndex := argIndex + 1
  145.         else if str = 'T' then            { set tab size }
  146.             argIndex := argIndex + 1
  147.         else if str = 'D' then
  148.             { nothing }
  149.     end;
  150.  
  151.  
  152.     procedure ReadCommandLine;
  153.     var    argVIndex:    integer;
  154.             arg:            Str255;
  155.     begin
  156.         if argc = 1 then
  157.             SyntaxError(9,'');
  158.         argVIndex := 1;
  159.         while argVIndex < argc do begin
  160.             arg := argv^[argVIndex]^;
  161.             if length(arg) <> 0 then
  162.                 if arg[1] = '-' then
  163.                     if length(arg) > 1 then
  164.                         HandleOption(arg,argVIndex)
  165.                     else
  166.                         SyntaxError(8,'');
  167.             argVIndex := argVIndex + 1;
  168.         end;    { while }
  169.     end;
  170.     
  171.  
  172.     procedure ReportError(error: integer; filename: Str255);
  173.     {
  174.         Generate the appropriate error message then exit from the
  175.         program.  Return a status value indicating early 
  176.         termination from the program.
  177.     }
  178.     begin
  179.         if error = 0 then
  180.             exit(ReportError);
  181.         
  182.         write(diagnostic,'ERROR! ');
  183.         case error of
  184.             -35:    writeln(diagnostic,filename,' volume does not exist');
  185.             -36:    writeln(diagnostic,filename,' IO Error');
  186.             -37:    writeln(diagnostic,filename,' is a bad filename or volume name');
  187.             -42:    writeln(diagnostic,'Too many files open');
  188.             -43:    writeln(diagnostic,filename,' not found');
  189.             -45:    writeln(diagnostic,filename,' is locked');
  190.             -46:    writeln(diagnostic,filename,' is locked by a software flag');
  191.             -47:    writeln(diagnostic,filename,' is busy; one or more files are open');
  192.             -53:    writeln(diagnostic,filename,' volume not on-line');
  193.             -54:    writeln(diagnostic,filename,' cannot be opened for writing, file is locked');
  194.             -61:    writeln(diagnostic,filename,' Read/write permission doesn''t allow writing');
  195.             otherwise
  196.                     writeln(diagnostic,'OS error #',error,' has occurred.');
  197.                     writeln(diagnostic,'    Reference Inside Macintosh pp. III:205-209 for further details');
  198.         end;
  199.         IEExit(2);
  200.     end;
  201.     
  202.     
  203. begin {main program}
  204.     InitCursorCtl(nil);            { make first stmt to avoid heap fragmentation }
  205.     InitFonts;                        { so we can read in font names }
  206.     SetResLoad(false);            { so we read in JUST the font names! }
  207.     
  208.     gResDelete := false;            { do not delete file's resources }
  209.     gFont := 4;                        { set the defalut font to Monaco }
  210.     gFontSize := 9;                { set the defalut font size to 9 point }
  211.     gTabSize := 3;                    { set the defalut tab setting to 3 }
  212.     
  213.     ReadCommandLine;
  214.     
  215.     arg := gFont;
  216.     arg := BSL(arg, 16);
  217.     arg := arg + gFontSize;
  218.  
  219.     anOSError:=GetVol(aStringPtr,vRefNum);
  220.     if anOSError <> 0 then
  221.         ReportError(anOSError,aStringPtr^);
  222.     
  223.     i := 1;
  224.     while i < argc do begin
  225.         RotateCursor(32);                            { Make cursor rotate each time through loop }
  226.         filename := argv^[i]^;
  227.         
  228.         if length(filename) = 0 then begin
  229.             i := i + 1;
  230.             cycle;
  231.         end;
  232.         
  233.         if filename[1] = '-' then
  234.             SkipOption(filename,i)
  235.         else begin
  236.             anOSError := GetFInfo(filename,vRefNum,fnderInfo);
  237.             if anOSError <> 0 then begin
  238.                 ReportError(anOSError,filename);
  239.                 cycle;
  240.             end
  241.             else begin
  242.                 if (fnderInfo.fdType = 'TEXT') and (fnderInfo.fdCreator = 'MPS ') then begin
  243.                     if gResDelete then begin
  244.                         anOSError := OpenRF(filename,vRefNum,ResRefNum);
  245.                         anOSError := SetEOF(ResRefNum,0);
  246.                         anOSError := FSClose(ResRefNum);
  247.                     end;
  248.                     result := IEFAccess(filename,F_STabInfo,gTabSize);
  249.                     result := IEFAccess(filename,F_SFontInfo,arg);
  250.                 end
  251.                 else 
  252.                     writeln('WARNING!  ',filename,' is not an MPW text file, resources not deleted');
  253.             end;
  254.         end;
  255.         i := i + 1;
  256.     end;    { while i < argc }
  257.     writeln;
  258.  
  259.     SetResLoad(true);
  260.     IEExit(0);                        { Normal status return }
  261. end. {main program}
  262.